Initial Set Up Steps

library(shinydashboard)
library(tidyverse)
library(leaflet)
library(shiny)
library(Rcpp)
library(sf)
library(tmaptools)
library(htmlwidgets)
library(googlesheets4)
library(RColorBrewer)
library(lubridate)
library(purrr)
library(shinythemes)

library(censusapi)
library(rgeos)
library(tidycensus)
library(tigris)
library(usmap)

library(colorspace)
library(ggplot2)
library(reshape2)
library(formattable)
library(plotly)
library(lubridate)

Sys.setenv(CENSUS_KEY="c8aa67e4086b4b5ce3a8717f59faa9a28f611dab")
github_directory <- "https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/"
github_rds <- "https://github.com/stanfordfuturebay/stanfordfuturebay.github.io/blob/master/data/"

options(
  tigris_class = "sf",
  tigris_use_cache = TRUE
)

mapbox_sat <- "https://api.mapbox.com/styles/v1/samanyl/ck9hpl0sm0fuq1ip8yfb2yrn8/tiles/256/{z}/{x}/{y}@2x?access_token=pk.eyJ1Ijoic2FtYW55bCIsImEiOiJjazlocGNvYWgxMHhxM2Rud2pxdzVnMnp2In0.D_j3K9tXiEddHH-8UUkeZQ"
mapbox_satAtt <- "© <a href='https://www.mapbox.com/map-feedback/'>Mapbox</a> Satellite Map"

bay_county_names <-
  c(
    "Alameda",
    "Contra Costa",
    "Marin",
    "Napa",
    "San Francisco",
    "San Mateo",
    "Santa Clara",
    "Solano",
    "Sonoma"
  )

bay_counties <- readRDS(gzcon(url(paste0(github_rds,"bay_counties.rds?raw=true"))))

setwd("C:/Users/liusa/github/covid19/snap project/sam")


# bay_counties <-
#   counties("CA", cb = F, progress_bar=F) %>%
#   filter(NAME %in% bay_county_names)
#
# zctas <-
#   zctas(cb=F)
#
# bay_zctas <-
#   zctas %>%
#   dplyr::select(ZCTA5CE10) %>%
#   st_join(bay_counties %>% dplyr::select(geometry),left=F)
#
# saveRDS(bay_zctas, file = "bay_zctas.rds")
gs4_deauth()

retailers <- read_sheet("1tvMBCWNeh7kyyKklntmWfV1zNJx8bN-KxHIYmaULZxg")

retailers$long <- as.numeric(retailers$long)
retailers$lat <- as.numeric(retailers$lat)

snap <- retailers %>% filter(type == "SNAP_accepting_retailer")
wic <- retailers %>% filter(type == "WIC_only_store")
snap_wic <- retailers %>% filter(type == "WIC_SNAP_retailer")
snap_restaurant <- retailers %>% filter(type=="SNAP_restaurant")
snap_farmers <- retailers %>% filter(type=="SNAP_farmers_market")

snap_curbside <- snap %>% filter(!is.na(curbside_pickup))
wic_curbside <- wic %>% filter(!is.na(curbside_pickup))
snapwic_curbside <- snap_wic %>% filter(!is.na(curbside_pickup))
snaprest_curbside <- snap_restaurant %>% filter(!is.na(curbside_pickup))
snapfarm_curbside <- snap_farmers %>% filter(!is.na(curbside_pickup))

snap_delivery <- snap %>% filter(!is.na(delivery))
wic_delivery <- wic %>% filter(!is.na(delivery))
snapwic_delivery <- snap_wic %>% filter(!is.na(delivery))
snaprest_delivery <- snap_restaurant %>% filter(!is.na(delivery))
snapfarm_delivery <- snap_farmers %>% filter(!is.na(delivery))

snap_senior <- snap %>% filter(!is.na(senior_hours))
wic_senior <- wic %>% filter(!is.na(senior_hours))
snapwic_senior <- snap_wic %>% filter(!is.na(senior_hours))
snaprest_senior <- snap_restaurant %>% filter(!is.na(senior_hours))
snapfarm_senior <- snap_farmers %>% filter(!is.na(senior_hours))

snapIcon <- makeIcon(
  iconUrl = "baymap/bag.png",
  iconWidth=25,iconHeight=25)

wicIcon <- makeIcon(
  iconUrl = "baymap/love.png",
  iconWidth=30,iconHeight=30)

snapwicIcon <- makeIcon(
  iconUrl = "baymap/snapwic.png",
  iconWidth=30,iconHeight=30)

snaprestIcon <- makeIcon(
  iconUrl = "baymap/cutlery.png",
  iconWidth=25,iconHeight=25)

snapfarmIcon <- makeIcon(
  iconUrl = "baymap/chicken.png",
  iconWidth=25,iconHeight=25)

homeIcon <- makeIcon(
  iconUrl = "baymap/internet.png",
  iconWidth=25,iconHeight=25)

html_legend <- "<img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/bag.png' height='30' width='30'> SNAP Only Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/love.png' height='30' width='30'> WIC Only Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/snapwic.png' height='30' width='30'> SNAP and WIC Accepting Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/money.png' height='30' width='30'> Cash EBT Withdrawal Locations<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/cutlery.png' height='30' width='30'> SNAP Accepting Restaurants<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/chicken.png' height='30' width='30'> SNAP Accepting Farmers Markets"

cluster <-
  markerClusterOptions(
    showCoverageOnHover=F,
    spiderfyOnMaxZoom=F,
    disableClusteringAtZoom=14
    )

# time format --> format(dataset$____, %I:%M%p)

pop <- function(dataset){
  result <-
    paste0(
      ifelse(
        is.na(dataset$web_link),
        paste0("<strong>",dataset$site_name,"</strong><br>"),
        paste0("<a href='",dataset$web_link,"' target='_blank'><strong>",dataset$site_name,"</strong></a><br>")
      ),
      dataset$address, "<br>",
      dataset$city,", ",
      dataset$state," ",
      dataset$zip,
      "<br><br><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/pin.png' height='12' width='12'>
      <a href='https://www.google.com/maps/dir/?api=1&destination=",
      dataset$lat,",",
      dataset$long,"' target='_blank'>Directions To Here</a>",
      '<br><br><strong>Hours of Operation: </strong><br>',
      dataset$days_hours_line1,
      ifelse(
        is.na(dataset$days_hours_line2),
        "",
        paste0("<br>",dataset$days_hours_line2)
      ),
      ifelse(
        is.na(dataset$days_hours_line3),
        "",
        paste0("<br>",dataset$days_hours_line3)
      ),
      ifelse(
        is.na(dataset$days_hours_line4),
        "",
        paste0("<br>",dataset$days_hours_line4)
      ),
      "<br><br><strong>Contact Information:</strong><br>",
      ifelse(
        is.na(dataset$web_link),
        "",
        paste0("<a href='",dataset$web_link,"' target='_blank'>Website</a><br>")
      ),
      dataset$phone,"<br>",
      ifelse(
        is.na(dataset$notes),
        "",
        paste0("<br><strong>Notes: </strong>",dataset$notes,"<br>")
      ),
      ifelse(
        is.na(dataset$senior_hours),
        "",
        paste0(
          '<br><strong style="color:red">** SPECIAL SENIOR HOURS ** </strong><br>',
          dataset$senior_hours)
      )
    )
  return(result)
}
bay_zctas <- readRDS("P:/Stanford/Classes/CEE218Z - Shaping the Future of the Bay/bay_zctas.rds")

wd <- "P:/Shared/SFBI/Restricted Data Library/Safegraph/covid19analysis/transactions-facteus/"

combining <- function(pattern) {
  files <- list.files(pattern = pattern)
  return(do.call(rbind, lapply(files,readRDS)))
}

spending_total <- readRDS(paste0(wd,"cut-1-daily-spend-by-zip/2020-04-22/cut-1-daily-spend-by-zip-20170101-20200417-bay.rds"))

setwd(paste0(wd,"cut-2-daily-spend-by-zip-by-mcc/2020-04-22"))
spending_MCC <-
  combining("cut-2-daily-spend-by-zip-by-mcc-20170101-20200417-[0-1][0-9]-bay.rds")

setwd(paste0(wd,"cut-3-daily-spend-by-brand/2020-04-22"))
spending_brand <- combining("daily-spend-by-brand-20170101-20200417-[0-1][0-9]-bay.rds")

walmart_instore <- readRDS(paste0(wd,"cut-4-daily-spend-at-walmart/2020-04-22/daily-spend-by-zip-walmart-instore-20170101-20200417-bay.rds"))

walmart_online <- readRDS(paste0(wd,"cut-4-daily-spend-at-walmart/2020-04-22/daily-spend-by-zip-walmart-online-20170101-20200417-bay.rds"))

gcf <- read.csv("P:/Shared/SFBI/Restricted Data Library/CalFresh/last_365_by_zip.csv")

setwd("C:/Users/liusa/github/covid19/snap project/sam")

Leaflet Snap Circle Icons

cols <- brewer.pal(5, name='Set1')
retail.col <- colorFactor(cols, domain = c("SNAP_accepting_retailer","WIC_only_store","WIC_SNAP_retailer","SNAP_restaurant",
                                           "SNAP_farmers_market"))

mpc <- leaflet() %>%
    addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
    addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
    addCircleMarkers(
      lng = retailers$long,
      lat = retailers$lat,
      color = retail.col(retailers$type),
      radius = 5,
      popup = pop(retailers)
      ) %>%
    addLegend(
      position = 'bottomleft',
      values = subset(retailers$type,!is.na(retailers$type)),
      na.label = "",
      pal = retail.col,
      title='Stores'
      ) %>%
    addLayersControl(
      baseGroups = c("Default","Satellite")
      )

mpc

Leaflet Snap with Flat Icons

mpi <- leaflet() %>%
    addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
    # addProviderTiles(providers$CartoDB.Positron, group = "Positron") %>% # add mapbox
    addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
    addMarkers(
      lng = snap$long,
      lat = snap$lat,
      clusterOptions = cluster,
      popup = pop(snap),
      icon = snapIcon,
      group = "SNAP Only Retailers"
      ) %>%
    addMarkers(
      lng = wic$long,
      lat = wic$lat,
      clusterOptions = cluster,
      popup = pop(wic),
      icon = wicIcon,
      group = "WIC Only Retailers"
      ) %>%
    addMarkers(
      lng = snap_wic$long,
      lat = snap_wic$lat,
      clusterOptions = cluster,
      popup = pop(snap_wic),
      icon = snapwicIcon,
      group = "SNAP and WIC Accepting Retailers"
      ) %>%
    addMarkers(
      lng = snap_restaurant$long,
      lat = snap_restaurant$lat,
      clusterOptions = cluster,
      popup = pop(snap_restaurant),
      icon = snaprestIcon,
      group = "SNAP Accepting Restaurants"
      ) %>%
    addMarkers(
      lng = snap_farmers$long,
      lat = snap_farmers$lat,
      clusterOptions = cluster,
      popup = pop(snap_farmers),
      icon = snapfarmIcon,
      group = "SNAP Accepting Farmers Markets"
      ) %>%
    addMarkers(
      lng = snap_curbside$long,
      lat = snap_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snap_curbside),
      icon = snapIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = wic_curbside$long,
      lat = wic_curbside$lat,
      clusterOptions = cluster,
      popup = pop(wic_curbside),
      icon = wicIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snapwic_curbside$long,
      lat = snapwic_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snapwic_curbside),
      icon = snapwicIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snaprest_curbside$long,
      lat = snaprest_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snaprest_curbside),
      icon = snaprestIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snapfarm_curbside$long,
      lat = snapfarm_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snapfarm_curbside),
      icon = snapfarmIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snap_delivery$long,
      lat = snap_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snap_delivery),
      icon = snapIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = wic_delivery$long,
      lat = wic_delivery$lat,
      clusterOptions = cluster,
      popup = pop(wic_delivery),
      icon = wicIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snapwic_delivery$long,
      lat = snapwic_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snapwic_delivery),
      icon = snapwicIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snaprest_delivery$long,
      lat = snaprest_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snaprest_delivery),
      icon = snaprestIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snapfarm_delivery$long,
      lat = snapfarm_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snapfarm_delivery),
      icon = snapfarmIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snap_senior$long,
      lat = snap_senior$lat,
      clusterOptions = cluster,
      popup = pop(snap_senior),
      icon = snapIcon,
      group = "Offers Senior Hours"
      ) %>%
    addMarkers(
      lng = wic_senior$long,
      lat = wic_senior$lat,
      clusterOptions = cluster,
      popup = pop(wic_senior),
      icon = wicIcon,
      group = "Offers Delivery"
      ) %>%
    addMarkers(
      lng = snapwic_senior$long,
      lat = snapwic_senior$lat,
      clusterOptions = cluster,
      popup = pop(snapwic_senior),
      icon = snapwicIcon,
      group = "Offers Delivery"
      ) %>%
    addMarkers(
      lng = snaprest_senior$long,
      lat = snaprest_senior$lat,
      clusterOptions = cluster,
      popup = pop(snaprest_senior),
      icon = snaprestIcon,
      group = "Offers Delivery"
      ) %>%
    addMarkers(
      lng = snapfarm_senior$long,
      lat = snapfarm_senior$lat,
      clusterOptions = cluster,
      popup = pop(snapfarm_senior),
      icon = snapfarmIcon,
      group = "Offers Delivery"
      ) %>%
    addLayersControl(
      baseGroups = c("Default","Satellite"),
      overlayGroups = c("SNAP Only Retailers","WIC Only Retailers","SNAP and WIC Accepting Retailers","Cash EBT Withdrawal Locations",
                        "SNAP Accepting Restaurants","SNAP Accepting Farmers Markets",
                        "Offers Curbside Pick-up", "Offers Delivery","Offers Senior Hours")
      ) %>%
    addControl(
      html=html_legend,
      position="bottomleft") %>%
  hideGroup(c("Offers Curbside Pick-up", "Offers Delivery","Offers Senior Hours"))

mpi

Walmart vs. SNAP Demographics

## most popular/accessible walmart among zipcodes (plot number of transactions on map)

bay_zipcodes <-
  read.csv("baymap/bayarea_zipcodes.csv") %>%
  dplyr::select(PO_NAME,ZIP)

bay_zipcodes$ZIP <- as.character(bay_zipcodes$ZIP)

# spending_brand_sum <-
#   bay_zipcodes %>%
#   left_join(spending_brand %>% filter(merchant=="WALMART"),by=c("ZIP"="zip")) %>% 
#   group_by(merchant,ZIP,PO_NAME) %>%
#   summarize(
#     transactions_avg=round(mean(as.numeric(transaction_counts)))) %>%
#   left_join(bay_zctas,by=c("ZIP"="ZCTA5CE10")) %>%
#   distinct(ZIP,.keep_all = T) %>%
#   st_as_sf(dim = "XY", sf_column_name = "geometry") %>%
#   st_transform(crs=4326) %>%
#   mutate(combined=paste0(ZIP,": ",round(transactions_avg)," Daily Avg Walmart Transactions")) %>% 
#   na.omit()
# 
# spending_brand_sum <- spending_brand_sum[order(spending_brand_sum$transactions_avg),]
# 
# saveRDS(spending_brand_sum,"baymap/spending_brand_sum.rds")
# 
# gcf["zip"] <- as.character(gcf$zip)
# 
# gcf_bay <-
#   gcf %>%
#   right_join(bay_zctas,by=c("zip"="ZCTA5CE10")) %>%
#   filter(zip %in% spending_brand_sum$ZIP) %>%
#   distinct(zip,.keep_all = T) %>%
#   st_as_sf(dim = "XY", sf_column_name = "geometry") %>%
#   st_transform(crs=4326) %>%
#   mutate(combined=paste0(zip,": ",total_individuals, " SNAP Residents")) %>% 
#   na.omit()
# 
# gcf_bay <- gcf_bay[order(gcf_bay$total_individuals),]
# 
# saveRDS(gcf_bay,"baymap/gcf_bay.rds")

spending_brand_sum <- readRDS("baymap/spending_brand_sum.rds")
spending_brand_sum_top10 <- tail(spending_brand_sum,10)
spending_brand_sum_top25 <- tail(spending_brand_sum,25)
spending_brand_sum_top50 <- tail(spending_brand_sum,50)

gcf_bay <- readRDS("baymap/gcf_bay.rds")
gcf_bay_top10 <- tail(gcf_bay,10)
gcf_bay_top25 <- tail(gcf_bay,25)
gcf_bay_top50 <- tail(gcf_bay,50)

col <- c("#068a9c","#d44a1e")

fp <- leaflet() %>%
    addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
    addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
    addPolygons(
      data = spending_brand_sum_top10,
      weight=2,
      color = "#5c2a9d",
      label = spending_brand_sum_top10$combined,
      group = "Walmart Top 10"
      ) %>%
    addPolygons(
      data = spending_brand_sum_top25,
      weight=2,
      color = "#5c2a9d",
      label = spending_brand_sum_top25$combined,
      group = "Walmart Top 25"
      ) %>%
    addPolygons(
      data = spending_brand_sum_top50,
      color = "#5c2a9d",
      weight=2,
      label =  spending_brand_sum_top50$combined,
      group = "Walmart Top 50"
      ) %>%
    addPolygons(
      data = gcf_bay_top10,
      weight=2,
      color = "#e2598b",
      label = gcf_bay_top10$combined,
      group = "SNAP Top 10"
      ) %>%
    addPolygons(
      data = gcf_bay_top25,
      weight=2,
      color = "#e2598b",
      label = gcf_bay_top25$combined,
      group = "SNAP Top 25"
      ) %>%
    addPolygons(
      data = gcf_bay_top50,
      color = "#e2598b",
      weight=2,
      label = gcf_bay_top50$combined,
      group = "SNAP Top 50"
      ) %>%
    addLayersControl(
      baseGroups = c("Default","Satellite"),
      overlayGroups = c("Walmart Top 10","Walmart Top 25","Walmart Top 50", 
                        "SNAP Top 10","SNAP Top 25", "SNAP Top 50")
    ) %>%
  hideGroup(c("Walmart Top 10","Walmart Top 50","SNAP Top 10","SNAP Top 50"))

fp
walsnap_tbl <-
  gcf_bay_top50 %>%
  dplyr::select(-geometry) %>%
  as.data.frame() %>%
  left_join(spending_brand_sum_top50 %>% dplyr::select(-geometry) %>% as.data.frame(), by=c("zip"="ZIP"),suffix=c("_SNAP","_walmart")) %>%
  na.omit() %>%
  dplyr::select(zip,total_individuals,transactions_avg) %>%
  left_join(bay_zipcodes, by=c("zip"="ZIP")) %>%
  dplyr::rename("Zip"="zip","CITY"="PO_NAME","SNAP Residents"="total_individuals","Daily Avg Walmart Transactions"="transactions_avg") %>% 
  formattable(align = c(rep("c"))) %>% 
  as.datatable()

walsnap_tbl

Shiny App Implementation